home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr10 / tvprompt.zip / TV_PROMP.PKG < prev   
Text File  |  1992-06-02  |  6KB  |  174 lines
  1. with Doscall,
  2.      Reader,
  3.      Screen,
  4.      System,
  5.      Text_Io;
  6.  
  7. procedure TV_Prompt is
  8.  
  9.   Copyright: constant String := "Copyright 1992, Tom Moran";
  10.  
  11.   Copy_Owner: constant String :=
  12.     "This copy uploaded to Compuserve for use by anybody";
  13.  
  14.   -- if a console input is longer than one line before a CR, stop
  15.   -- file scrolling until either a CR from the console or a long time
  16.   -- between console keystrokes.
  17.   Defer_To_Console_Duration: constant Duration := 3.0;
  18.  
  19.   subtype Scroll_Rates is Character range '0' .. '9';
  20.   Scroll_Passage_Time: constant array (Scroll_Rates) of Duration
  21.     := (0.0, 16.0, 15.0, 14.0, 13.0, 12.0, 10.0, 8.0, 6.0, 4.0);
  22.   Current_Scroll_Passage_Time: Duration := Screen.Initial_Scroll_Passage_Time;
  23.  
  24.   procedure Act_On_Keyins is
  25.     Nothing : constant Character := Ascii.Nul;
  26.     This_Char: Character;
  27.     Keyed_String: Screen.Scrollable_Strings;
  28.     Keyed_Count: Natural := 0;
  29.     Stopped : Boolean := False; -- is scrolling stopped?
  30.     Long_Interjection: Boolean := False; -- long line w/o cr
  31.  
  32.     function What_Char return Character is
  33.     -- return Nothing if no keyin
  34.       use System;
  35.       Regs    : Doscall.Most_Regs;
  36.       B       : Integer;
  37.     begin
  38.       Regs.Dx := 16#00FF#; -- test for input
  39.       Doscall.Dos_Call(16#06#, Regs);
  40.       if (Regs.Flags / 64) mod 2 /= 0 then
  41.         -- nothing typed
  42.         return Nothing;
  43.       end if;
  44.       B := Integer(Regs.Ax mod 256);
  45.       if B = 0 then
  46.         -- function key, skip next half
  47.         Regs.Dx := 16#00FF#; -- test for input
  48.         Doscall.Dos_Call(16#06#, Regs);
  49.         B := Character'Pos(Ascii.Cr);
  50.       elsif B < Character'Pos(' ') then
  51.         B := Character'Pos(Ascii.Cr);
  52.       elsif B > 127 then
  53.         B := Character'Pos(' ');
  54.       end if;
  55.       return Character'Val(B);
  56.     end What_Char;
  57.  
  58.   begin  -- Act_On_Keyins
  59.     Check_Keyboard:
  60.     loop
  61.       This_Char := What_Char;
  62.       if This_Char = Nothing then
  63.         delay 0.2;
  64.       else
  65.         if Keyed_Count = 0 then
  66.           -- first position, check for control
  67.           if This_Char = '.' then -- operator wants us to quit
  68.             exit Check_Keyboard;
  69.           elsif This_Char in Scroll_Rates then -- change to different speed
  70.             Screen.Scroller.Adjust_Speed(Scroll_Passage_Time(This_Char));
  71.             Stopped := This_Char = '0';
  72.             if not Stopped then
  73.               Current_Scroll_Passage_Time := Scroll_Passage_Time(This_Char);
  74.             end if;
  75.           elsif This_Char = '+' then -- faster! cut scroll passage time
  76.             Current_Scroll_Passage_Time
  77.               := Current_Scroll_Passage_Time-Current_Scroll_Passage_Time/10;
  78.             Screen.Scroller.Adjust_Speed(Current_Scroll_Passage_Time);
  79.             Stopped := False;
  80.           elsif This_Char = '-' then -- slower! increase passage time
  81.             Current_Scroll_Passage_Time
  82.               := Current_Scroll_Passage_Time+Current_Scroll_Passage_Time/10;
  83.             Screen.Scroller.Adjust_Speed(Current_Scroll_Passage_Time);
  84.             Stopped := False;
  85.           elsif This_Char /= Ascii.Cr and not Stopped then
  86.             -- continuation line
  87.             Keyed_String := "                    ";
  88.             Keyed_Count := 2;
  89.             Keyed_String(2) := This_Char;
  90.           end if;
  91.         else
  92.           -- not first char in line
  93.           if This_Char = Ascii.Cr then
  94.             Screen.Scroller.Put(Keyed_String, White_On_Black => True);
  95.             if Reader.Read_File'callable then
  96.               begin
  97.                 select
  98.                   Reader.Read_File.End_Defer;
  99.                 else
  100.                   null;  -- it may not be defering anyway
  101.                 end select;
  102.               exception
  103.                 when Tasking_Error =>
  104.                   null; -- OK if Reader.Read_File terminated between
  105.                         -- 'if callable' and 'select'
  106.               end;
  107.             end if;
  108.             Long_Interjection := False;
  109.             Keyed_Count := 0;
  110.           else
  111.             Keyed_Count := Keyed_Count + 1;
  112.             Keyed_String(Keyed_Count) := This_Char;
  113.             if Long_Interjection
  114.             and then Reader.Read_File'callable then
  115.               begin
  116.                 select
  117.                   Reader.Read_File.Continue_Deferring;
  118.                 else
  119.                   null;
  120.                 end select;
  121.               exception
  122.                 when Tasking_Error =>
  123.                   null; -- OK if read_file terminated
  124.               end;
  125.             end if;
  126.             if Keyed_Count = Screen.Scrollable_Strings'Last then
  127.               if (not Long_Interjection)
  128.               and then Reader.Read_File'callable then
  129.                 begin
  130.                   select
  131.                     -- start read_file defering to console
  132.                     Reader.Read_File.Defer(Defer_To_Console_Duration);
  133.                     Long_Interjection := True;
  134.                   or
  135.                     delay 1.5;
  136.                   end select;
  137.                 exception
  138.                   when Tasking_Error =>
  139.                     null; -- OK if read_file terminated
  140.                 end;
  141.               end if;
  142.               Screen.Scroller.Put(Keyed_String, White_On_Black => True);
  143.               Keyed_Count := 1; -- start rest of line with ' ' so +-. OK
  144.               Keyed_String := "                    ";
  145.             end if;
  146.           end if;
  147.         end if;
  148.       end if;
  149.     end loop Check_Keyboard;
  150.   end Act_On_Keyins;
  151.  
  152. begin -- TV_Prompt
  153.  
  154.   Text_Io.Put(Copyright);
  155.   Text_Io.New_Line;
  156.   Text_Io.Put(Copy_Owner);
  157.   delay 1.0;
  158.   Screen.Scroller.Start_Up;
  159.   Reader.Read_File.Start_Up;
  160.   Act_On_Keyins;
  161.   if not Reader.Read_File'terminated then
  162.     -- tell it to die
  163.     select
  164.       Reader.Read_File.Premature_Death;
  165.     or
  166.       -- remembering that it may be delaying on a Defer to console
  167.       -- before it looks up and sees us calling
  168.       delay Defer_To_Console_Duration+1.0;
  169.     end select;
  170.   end if;
  171.   Screen.Scroller.Wind_Up;
  172.  
  173. end TV_Prompt;
  174.